Amiga Format CD 51/Amiga Format CD51 (2000-03-10)(Future Publishing)(GB)[!][issue 2000-04].iso/-in_the_mag-/banging_the_metal/demo/charmode32x12_bas

Text File | 2000-01-01 | 15KB | 373 lines

100 REMark Custom Amiga Qdos character-mapped screens
110 REMark 2345678901234567890123456789012345678901234567890123456789012345678901234
120 SCR_PRIORITY 4,1 :REMark Priority of Qdos, not custom, screen
130 REMark OCS 15KHz demonstration version 0.20, SNG January 2000
131 REMark V0.20 update: hard-wired for all updates in 32x12, 8x16
132 REMark V0.19 update: hard wires for all updates in 80x20 HiRes
133 REMark V0.18 update: stripes visible and symbols in foreground
135 REMark V0.17 updates: finds chip RAM even if Qdos is loaded high
137 REMark Uses an animated fount in modes with dynamic fount updates
140 WINDOW #2,512,200,0,0 : MODE 4 : CSIZE #0,2,0
150 custom=HEX("DFF000")
160 pagesize=2^16
170 chipspace=pagesize*3 :REMark Make sure we get two complete pages
180 REMark All structures start in one 64K page (xx0000) so that we only need
190 REMark to vary the low pointer words to move them. The Copper list may
200 REMark extend to a second page if thousands of characters are in use.
210 HeadLines%=51 :REMark Pixel lines at top of screen above character map area
220 CharHeight%=16 :REMark 1..16, 10=Qdos, 12=TRS-80, 8=PET
230 CharLines%=12 : CharColumns%=32 :REMark 32/40/64/80; ALWAYS CharWidth%=8
240 BlitFount=1 :REMark (CharHeight%=8) :REMark AND CharColumns%<=40) :REMark Set for 8x8 fount update
250 BlitChars=1 : REMark (CharColumns%<=40) :REMark Unpack CharMap each LoRes field
260 ShowTime=1 :REMark Set this flag for traditional stripes showing blitter phases
270 lines%=HeadLines%+CharLines%*CharHeight%
280 IF lines%<192 THEN PRINT"Too few lines for OCS! - add HeadLines!":STOP
290 IF lines%>287 THEN PRINT #0;"Too many lines for PAL! Drop ";lines%-287:STOP
300 width%=CharColumns% :REMark Bytes per line per bitplane (EVEN!)
310 last_sprite%=0 :REMark This one doesn't use sprites at all
320 IF width% && 1 : PRINT #0;"Uneven bitplane width": STOP
330 REMark At least 64 pixels fetched are masked by scrolling
340 border%=0/4 :REMark Extra bytes per line, 8..24, for scrolling
350 IF border% && 1 : PRINT #0;"Uneven bitplane border": STOP
360 left_edge%=152+8*last_sprite% :REMark Low resolution pixels
370 IF (CharColumns% MOD 40)=0 THEN left_edge%=left_edge%-40
380 IF CharColumns%=32 THEN left_edge%=left_edge%-20
390 top_line%=312-lines% :REMark 64 for 192 lines? CBM 1960 range is 26+
400 IF top_line%>64 THEN LET top_line%=64 :REMark Stay near top of screen
410 PRINT #0;"Total"!border%+width%!"bytes per pixel line"
420 DMACON_R=2
430 COPCON=46
440 BLTCON0=64
450 BLTCON1=66
460 BLTMASK=68
470 BLTBPT=76
480 BLTAPT=80
490 BLTDPT=84
500 BLTSIZE=88
510 BLTBMOD=98
520 BLTAMOD=100
530 BLTDMOD=102
540 BLTCDAT=112
550 COP1LC=HEX("80")
560 DIWSTART=HEX("8E")
570 DIWSTOP=HEX("90")
580 DDFSTART=HEX("92")
590 DDFSTOP=HEX("94")
600 DMACON_W=HEX("96")
610 BPL1PT=HEX("E0")
620 BPLCON0=HEX("100")
630 BPLCON1=HEX("102")
640 BPLCON2=HEX("104")
650 BPLCON3=HEX("106")
660 BPL1MOD=HEX("108")
670 BPL2MOD=HEX("10A")
680 SPR0PTH=HEX("120")
690 SPR0PTL=HEX("122")
700 COLOUR0=HEX("180")
710 COLOUR17=HEX("1A2")
720 COLOUR18=HEX("1A4")
730 COLOUR19=HEX("1A6")
740 COLOUR1=HEX("182")
750 HTOTAL=HEX("1C0")
760 HSSTOP=HEX("1C2")
770 HBSTART=HEX("1C4")
780 HBSTOP=HEX("1C6")
790 VTOTAL=HEX("1C8")
800 VSSTOP=HEX("1CA")
810 VBSTART=HEX("1CC")
820 VBSTOP=HEX("1CE")
830 BEAMCON0=HEX("1DC")
840 HSSTART=HEX("1DE")
850 VSSTART=HEX("1E0")
860 HCENTRE=HEX("1E2")
870 DIWHIGH=HEX("1E4")
880 FMODE=HEX("1FC")
890 :
900 REMark Errors must return to Qdos mode
910 ql_off=0
920 WHEN ERRor
930 IF ql_off : QL_ON
940 PRINT #0;"At ";ERLIN; : REPORT
950 STOP
960 END WHEN
970 :
980 CLCHP
990 cpu_blit=0 :REMark Clear for COPPER_BLITs
1000 MAKE_CLIST
1010 BLIT_OFF : PAUSE 10
1020 screen=backdrop
1030 POKE_W COPCON+custom,2*(NOT cpu_blit) :REMark Allow Copper to Blit
1035 POKE$ CharMap,FILL$(CHR$(0),CharLines%*CharColumns%)
1040 POKE$ CharMap+(CharLines% DIV 2)*CharColumns%,FILL$(""&CHR$(0),CharColumns%)
1045 IF BlitFount THEN CHAR_GRID
1050 CUSTOM_ON
1060 i=0 : IF BlitFount THEN BorderLines%=4: ELSE BorderLines%=CharLines%
1070 REPeat poll
1080   IF INKEY$(#0,1)<>"" : EXIT poll
1090   i=((i+1) && 255)
1095   IF BlitFount: POKE$ fount+4096,PEEK$(patterns+((i*16) && 112),16)
1100   IF (i && 1)=1 : POKE$ CharMap,FILL$(CHR$(i),CharColumns%*BorderLines%)
1105   IF BlitFount AND (i && 3)=2 : POKE$ CharMap+CharColumns%*(CharLines%-BorderLines%),FILL$(CHR$(255-i),CharColumns%*BorderLines%)
1110 END REPeat poll
1120 QL_ON : REMark IF BlitFount : RECHP patterns avoids 64 byte re-run creep
1130 STOP
1140 :
1150 REMark Copper list codegen PROCs
1160 :
1170 DEFine PROCedure MOVE(value%,reg%)
1180 POKE_W copper,reg%
1190 POKE_W copper+2,value%
1200 copper=copper+4
1210 END DEFine MOVE
1220 :
1230 DEFine PROCedure WAIT(x%,y%)
1240 POKE_W copper,(y% && 255)*256+(x% && 254)+1
1250 POKE_W copper+2,32766 :REMark Blitter wait & use all X/Y bits
1260 copper=copper+4
1270 END DEFine WAIT
1280 :
1290 DEFine PROCedure SKIP(x%,y%)
1300 POKE_W copper,(y% && 255)*256+(x% && 254)+1
1310 POKE_W copper+2,32767 :REMark Blitter wait & use all X/Y bits
1320 copper=copper+4
1330 END DEFine SKIP
1340 :
1350 DEFine PROCedure MAKE_CLIST
1360 LOCal y,sp :REMark Creates lots of globals
1370 base=ALCHP(chipspace)
1380 IF base<1 OR base+chipspace>=2^21
1390   IF base>0 : RECHP base
1400   base=2^21-2^17:REMark 0.17 PRINT #0;"Required Chip RAM not found!" : STOP
1410 END IF
1420 page=INT(base/pagesize)+1
1430 pagebase=page*pagesize : backdrop=pagebase+8192 :REMark Obsolete?
1440 line_length%=width%+border%
1450 fount_low=0 : Plane=pagebase+8192 : CharMap=Plane+line_length%*lines%+128
1460 fount=fount_low+pagebase
1470 PRINT #0;"Loading fount for character height ";CharHeight%
1480 LOAD_FOUNT
1490 INK #2,7 : PAPER #2,0 : CLS #2 : LIST 100 TO 200
1500 PAUSE 10 : REMark 0.17 Allow time for update
1510 QDOS2 Plane
1520 :
1530 REMark Ensure line alignment, then make the actual copper list
1540 copper=CharMap+CharColumns%*CharLines%
1550 copper=16+INT(copper/16)*16
1560 clist=copper
1570 PRINT #0;"Setting up copper list ";
1580 MOVE #page TO BPL1PT
1590 MOVE #page TO BLTAPT
1600 MOVE #page TO BLTBPT
1610 MOVE #page TO BLTDPT
1620 MOVE #8192 TO BPL1PT+2
1630 IF CharColumns%>40
1640   MOVE #HEX("9200") TO BPLCON0 :REMark Hires Colour, 1 bitplane
1650 ELSE
1660   MOVE #HEX("1200") TO BPLCON0 :REMark LoRes Colour, one plane
1670 END IF
1680 MOVE #0 TO BPLCON3 :REMark No special AGA tricks
1690 MOVE #0 TO COLOUR0 :REMark Black background
1700 MOVE #HEX("0CC5") TO COLOUR1 : REMark Bright yellow foreground
1710 MOVE #top_line%*256+left_edge% TO DIWSTART :REMark True left limit
1720 IF CharColumns%>40
1730   MOVE #(top_line%+lines%)*256+left_edge%+width%*4+8 TO DIWSTOP
1740 ELSE
1745   zap=copper+2 :REMark Next line is dodgy and may need correction
1750   MOVE #(top_line%+lines%)*256+(255 && (left_edge%+width%*8+16)) TO DIWSTOP
1755   IF CharColumns%=32 THEN POKE zap+1,164 :REMark Bodge!
1760 END IF
1770 MOVE #left_edge% DIV 2 TO DDFSTART :REMark Hardware stop is at 18
1780 IF CharColumns%>40
1790   MOVE #(left_edge% DIV 2)+4*(width% DIV 2)-8 TO DDFSTOP :REMark Limit 204
1800 ELSE
1810   MOVE #(left_edge% DIV 2)+4*width%-8 TO DDFSTOP :REMark Limit 204
1820 END IF
1830 MOVE #HEX("2100") TO DIWHIGH  :REMark Set H8 and V8 (ECS only!)
1840 MOVE #0 TO BPL1MOD
1850 IF NOT cpu_blit THEN MAKE_COPPER_BLITS
1860 WAIT 255,255
1870 WAIT 255,255 :REMark Braces
1880 END DEFine MAKE_CLIST
1890 :
1900 DEFine PROCedure QL_ON
1910 POKE_W custom+DMACON_W,1024
1920 POKE_W custom+DMACON_W,32768+ql_dmacon
1930 POKE_L custom+COP1LC,HEX("18600")
1940 PAUSE 1
1950 POKE_W custom+COLOUR0,0
1960 POKE_W custom+COLOUR1,15 :REMark *256 for red
1970 BLIT_ON : ql_off=0
1980 END DEFine QL_ON
1990 :
2000 DEFine PROCedure CUSTOM_ON
2010 BLIT_OFF
2020 ql_off=1
2030 PAUSE 1
2040 ql_dmacon=PEEK_W(custom+DMACON_R)
2050 POKE_L custom+COP1LC,clist
2060 PAUSE 1
2070 POKE_W custom+DMACON_W,32 :REMark No sprites
2080 END DEFine CUSTOM_ON
2090 :
2100 DEFine PROCedure QDOS2(bitmap)
2110 REMark Test routine to throw a Qdos screen into a custom bitplane
2120 LOCal win_height,win_width,win_base,y :REMark GLOBAL line_length%
2130 win_height=lines%-1 :REMark Lines numbered from 0
2140 IF win_height>129 THEN win_height=129
2150 win_width =64 :REMark Bytes
2160 PRINT #0;"Copying Qdos window ";win_width*8;"x";win_height+1
2170 win_base=65536 :REMark Amiga bitplane of Qdos Screen
2180 FOR y=0 TO win_height
2190   POKE$ bitmap+y*line_length%,PEEK$(win_base,win_width)
2200   win_base=win_base+win_width
2210 END FOR y
2220 END DEFine QDOS2
2230 :
2240 DEFine PROCedure BLIT_CHAR
2250 IF BlitFount THEN charGap=16 : ELSE charGap=32
2260 MOVE #fount_low+0*charGap TO BLTBPT+2
2270 MOVE #fount_low+4*charGap TO BLTAPT+2
2280 MOVE #N TO BLTDPT+2 : N=N+2
2290 MOVE #1+CharHeight%*64 TO BLTSIZE
2300 WAIT COL,LIN :REMark Effectively WaitBlit
2310 COL=COL+GAP : IF COL>225 THEN COL=COL-226 : LIN=LIN+1
2320 END DEFine BLIT_CHAR
2330 :
2340 DEFine PROCedure SEE
2350 CUSTOM_ON
2360 PAUSE
2370 QL_ON
2380 END DEFine SEE
2390 :
2400 DEFine PROCedure S
2410 SAVE_O flp1_charmode_bas
2420 END DEFine S
2430 :
2440 DEFine PROCedure LOAD_FOUNT
2450 REMark fount=ALCHP(256*16*2)
2460 IF fount>0 AND fount<2^21
2470   IF 1 : REMark BlitFount=0
2480     REMark 256 characters, 16x16 bit patterns (justify top left)
2490     IF CharHeight%=16
2500       LBYTES flp1_Unpacked16x16_fount,fount
2510     ELSE
2520       LBYTES flp1_Unpacked16x9_fount,fount
2530     END IF
2540   ELSE
2550     LBYTES flp1_Packed8x8_fount,fount+4096
2560     REMark 256 characters, 8x8 for expansion
2570 ELSE
2580   PRINT #0;"No chip RAM for fount!"
2590   STOP
2600 END IF
2610 END DEFine LOAD_FOUNT
3040 :
3050 DEFine PROCedure EXPAND_FOUNT(a,b,c)
3060 REMark Expand 8x8 fount at A to 16x8 fount at B for C characters
3070 REMark A and B are offsets in the page, C is a WORD count
3080 IF ShowTime THEN MOVE #6*256 TO COLOUR0 :REMark Signal start of pass 1
3090 MOVE #HEX("09A0") TO BLTCON0 :REMark D := A & C (constant)
3100 MOVE #0 TO BLTCON1 :REMark Ascending pass
3110 MOVE #-1 TO BLTMASK :REMark Use all bits in first word
3120 MOVE #-1 TO BLTMASK+2 :REMark Last word, use all bits
3130 MOVE #0 TO BLTAMOD :REMark Source modulo
3140 MOVE #2 TO BLTDMOD :REMark Destination modulo
3150 MOVE #HEX("FF00") TO BLTCDAT :REMark Byte mask
3160 MOVE #a TO BLTAPT+2 :REMark Source
3170 MOVE #b TO BLTDPT+2 :REMark Destination
3180 MOVE #1024 TO DMACON_W :REMark Not Nasty (yet)
3190 MOVE #c*64+1 TO BLTSIZE
3200 WAIT 0,0
3210 IF ShowTime THEN MOVE #HEX("608") TO COLOUR0
3220 MOVE #2 TO BLTCON1 :REMark DESCENDING pass
3230 MOVE #a+2046 TO BLTAPT+2 :REMark Source
3240 MOVE #b+4094 TO BLTDPT+2 :REMark Destination
3250 MOVE #HEX("89A0") TO BLTCON0 :REMark D := (A * 256) & C
3260 MOVE #c*64+1 TO BLTSIZE
3270 WAIT 0,0 :REMark Wait for Blit to finish
3280 MOVE #page TO BLTDPT :REMark Stay in our page
3290 MOVE #page TO BLTAPT :REMark Stay in our page
3300 END DEFine EXPAND_FOUNT
3310 :
3320 DEFine PROCedure SETUP_CHAR_BLITS
3330 IF ShowTime THEN MOVE #5 TO COLOUR0 :REMark Blue during blitting
3340 IF CharColumns%>40 :MOVE #32768+1024 TO DMACON_W :REMark Get Nasty
3350 REMark Get set for Character blits
3360 MOVE #HEX("0DFC") TO BLTCON0 :REMark D := A v B for characters
3370 MOVE #HEX("8000") TO BLTCON1 :REMark B shift for characters
3380 MOVE #0 TO BLTBMOD
3390 MOVE #0 TO BLTAMOD
3400 MOVE #width%-2 TO BLTDMOD
3410 END DEFine SETUP_CHAR_BLITS
3420 :
3430 DEFine PROCedure MAKE_COPPER_BLITS
3440 REMark Generate copper list to unpack CharMap and Fount, and blit characters
3450 REMark Work out start line LIN, staying ahead of the beam
3460 LIN=top_line%+HeadLines%-CharHeight%-(CharHeight%=8)*((CharLines%+3) DIV 4)
3470 REMark Allow one extra scan per 32 for short characters, to stay ahead of beam
3480 IF BlitChars :LIN=LIN-((CharColumns%*CharLines%) DIV 80):REMark Bytes -> CLIST
3490 IF BlitFount :LIN=LIN-28 :REMark Allow time to unpack 2K fount to 4K
3500 IF CharColumns%>64 THEN LIN=LIN-CharLines%*2 :REMark Time to unpack CharMap
3510 WAIT 0,LIN : PRINT #0;"for line ";
3520 IF LIN<1 THEN PRINT #0;"No time - add HeadLines% if possible." : STOP
3530 t=CharHeight% :REMark Compute WAIT period between character blits
3540 SELect ON t:=9 TO 11:GAP=70:=12 TO 16:GAP=t*2+60:=1 TO 8:GAP=58
3550 IF CharColumns%>64 THEN GAP=GAP-4*(t>8)-2*(t>11):REMark Cut gap, more columns
3560 COL=GAP:TextLineBytes%=CharColumns%*CharHeight%:Start%=HeadLines%*width%+8192
3570 IF BlitChars THEN CHARS_TO_CLIST CharMap,CharColumns%*CharLines%
3580 IF CharColumns%<=40 : GAP=GAP*3/4 :REMark Not Nasty
3590 IF BlitFount THEN EXPAND_FOUNT fount+4096,fount,1024 :LIN=LIN+28
3600 SETUP_CHAR_BLITS :REMark Set Blitter registers the same for every character
3610 IF BlitChars:POKE_W FirstCharMove,copper-pagebase+6 :REMark First channel A ptr
3620 FOR textline=Start% TO Start%+TextLineBytes%*(CharLines%-1) STEP TextLineBytes%
3630   N=textline : AT #0,3,32 : PRINT #0,1+(N-Start%) DIV TextLineBytes%;
3640   FOR i=1 TO CharColumns% DIV 2 : BLIT_CHAR
3650 END FOR textline
3660 IF BlitChars:POKE_W LastCharMove,copper-pagebase-18 :REMark Last B word ptr
3670 IF ShowTime THEN MOVE #0 TO COLOUR0
3680 END DEFine MAKE_COPPER_BLITS
3690 :
3700 DEFine PROCedure CHARS_TO_CLIST(a,c)
3710 REMark Expand character code bytes at A to Copper list for C characters
3720 IF ShowTime THEN MOVE #112 TO COLOUR0 :REMark Signal start of pass 1
3730 IF CharHeight%=8
3740   MOVE #HEX("0FF0") TO BLTCDAT :REMark Byte mask for *16
3750   MOVE #HEX("49A0") TO BLTCON0 :REMark D := (A >> 4) & C (constant)
3760 ELSE
3770   MOVE #HEX("1FE0") TO BLTCDAT :REMark CharCode *32
3780   MOVE #HEX("39A0") TO BLTCON0 :REMark D := (A >> 3) & C (constant)
3790 END IF
3800 MOVE #0 TO BLTCON1 :REMark Ascending pass
3810 MOVE #-1 TO BLTMASK :REMark Use all bits in first word
3820 MOVE #-1 TO BLTMASK+2 :REMark Last word, use all bits
3830 MOVE #0 TO BLTAMOD :REMark Source modulo
3840 MOVE #18 TO BLTDMOD :REMark Destination modulo
3850 MOVE #a TO BLTAPT+2 :REMark Source
3860 MOVE #0 TO BLTDPT+2 :REMark Destination
3870 FirstCharMove=copper-2 :REMark Where to POKE later
3880 MOVE #1024 TO DMACON_W :REMark Not Nasty (yet)
3890 MOVE #c*32+1 TO BLTSIZE
3900 WAIT 0,0
3910 IF ShowTime THEN MOVE #60 TO COLOUR0
3920 MOVE #2 TO BLTCON1 :REMark DESCENDING pass
3930 IF CharHeight%<>8 THEN MOVE #HEX("59A0") TO BLTCON0
3940 MOVE #a+c-2 TO BLTAPT+2 :REMark Source
3950 MOVE #0 TO BLTDPT+2 :REMark Destinationn
3960 LastCharMove=copper-2 :REMark Last Copper B pointer
3970 MOVE #c*32+1 TO BLTSIZE
3980 WAIT 0,0 :REMark Wait for Blit to finish
3990 END DEFine CHARS_TO_CLIST
4000 :
4010 REMark New for version 0.17 - Set up patterns for animated fount
4015 DEFine PROCedure CHAR_GRID
4020 patterns=ALCHP(8*16)
4030 FOR char=0 TO 7
4035   vline=2^char : REMark Verticals
4037   base=patterns+char*16
4040   FOR row=0 TO 15
4050     POKE base+row,vline
4060     IF (row && 7)=char : POKE base+row,255
4070   END FOR row
4080 END FOR char
4090 END DEFine CHAR_GRID